home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu453.dms / pu453.adf / extras / basic_sources / wdb2.bas < prev   
BASIC Source File  |  1992-11-08  |  1KB  |  87 lines
  1. SCREEN 1,640,512,3,4
  2. WINDOW 1,"WorldDataBank",(0,0)-(620,490),0,1
  3. PALETTE 0,0,0,0   : PALETTE 1,0,.7,0
  4. PALETTE 2,1,0,0   : PALETTE 3,1,1,1
  5. PALETTE 4,.7,0,0  : PALETTE 5,0,1,0
  6. PALETTE 6,.2,.7,.5 : PALETTE 7,0,0,1
  7.  
  8. xs = 0 : ys = 0 
  9. xe = 600 : ye = 490
  10. xw = 600 : yw = 490
  11.  
  12. REM $option K300
  13.  
  14. DIM a%(150000)
  15.  
  16. mloc = VARPTR(a%(1))
  17.  
  18. OPEN "dh2:worlddatabank/wdb.5.all" AS #1 LEN=6
  19. 'OPEN "ram:wdb.5.all" AS #1 LEN=6
  20. FIELD #1,2 AS code$,2 AS y$,2 AS x$
  21. REM use CVI to convert
  22.  
  23. l = LOF(1)
  24.  
  25.  
  26. nrec = (l/6)-1
  27.  
  28. n = 0
  29. mag = 1
  30. xoff = 0
  31. yoff = 0
  32.  
  33. WHILE INKEY$ = "" AND n < nrec
  34.     INCR n
  35.     getrec2 n,t,x,y
  36.     
  37.     x = x + 10800
  38.     y = y + 5400
  39.     y = y/10800
  40.     x = x/21600
  41.     x = x - xoff
  42.     y = y - yoff
  43.     x = x * mag
  44.     y = y * mag
  45.     x = x * xw
  46.     y = y * yw
  47.     x = x + xs
  48.     y = y + ys
  49.     y = ye - y
  50.     
  51.     IF t > 10 THEN
  52.         COLOR INT(t/1000)
  53.         IF x < xe AND x > xs AND y < ye AND y > ys
  54.             PSET(x,y)
  55.         END IF
  56.         ox = x : oy = y
  57.     ELSE    
  58.         IF x < xe AND x > xs AND y < ye AND y > ys
  59.             IF ABS(x-ox) < 300 THEN
  60.                 LINE (ox,oy)-(x,y)
  61.             END IF 
  62.         END IF
  63.         ox = x : oy = y
  64.     END IF
  65. WEND
  66. CLOSE #1
  67.  
  68. SUB getrec(n,t,x,y,mstart) STATIC
  69.     SHARED nrec
  70.     IF n > nrec THEN n = nrec
  71.     n = INT(n)
  72.     x1 = ((n-1)*6)+mstart
  73.     t = PEEKW(x1)
  74.     y = PEEKW(x1+2)
  75.     x = PEEKW(x1+4)
  76. END SUB
  77.  
  78. SUB getrec2(n,t,x,y) STATIC
  79.     SHARED nrec,code$,x$,y$
  80.     n = INT(n)
  81.     GET #1,n
  82.     t = CVI(code$)
  83.     x = CVI(x$)
  84.     y = CVI(y$)
  85. END SUB
  86.  
  87.